Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/secure.fr_/secure.fr

Text File | 1995-07-06 | 6KB | 191 lines

VERSION 4.00
Begin VB.Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Connector"
   ClientHeight    =   2340
   ClientLeft      =   690
   ClientTop       =   1425
   ClientWidth     =   4755
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   2745
   Left            =   630
   LinkTopic       =   "Form1"
   ScaleHeight     =   2340
   ScaleWidth      =   4755
   Top             =   1080
   Width           =   4875
   Begin VB.CommandButton cmdClose
      Cancel          =   -1  'True
      Caption         =   "Cl&ose"
      Height          =   555
      Left            =   2520
      TabIndex        =   5
      Top             =   1380
      Width           =   1455
   End
   Begin VB.CommandButton cmdConnect
      Caption         =   "&Connect"
      Default         =   -1  'True
      Height          =   555
      Left            =   540
      TabIndex        =   4
      Top             =   1380
      Width           =   1455
   End
   Begin VB.TextBox txtPassword
      Height          =   285
      Left            =   1980
      TabIndex        =   3
      Top             =   780
      Width           =   1995
   End
   Begin VB.TextBox txtUserName
      Height          =   285
      Left            =   1980
      TabIndex        =   2
      Top             =   300
      Width           =   1995
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Password:"
      Height          =   195
      Left            =   720
      TabIndex        =   1
      Top             =   840
      Width           =   885
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "User name:"
      Height          =   195
      Left            =   720
      TabIndex        =   0
      Top             =   360
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

#If Win32 Then
    Private Declare Function GetWindowsDirectory Lib "Kernel32" _
        Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long
    Private Declare Function GetPrivateProfileString Lib "Kernel32" _
        Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
        ByVal nSize As Long, ByVal lpFileName As String) As Long
#Else
    Private Declare Function GetWindowsDirectory Lib "Kernel" _
        (ByVal lpBuffer As String, _
        ByVal nSize As Integer) As Integer

    Private Declare Function GetPrivateProfileString Lib "Kernel" _
        (ByVal lpApplicationName As String, _
        ByVal lpKeyName As Any, _
        ByVal lpDefault As String, _
        ByVal lpReturnedString As String, _
        ByVal nSize As Integer, _
        ByVal lpFileName As String) As Integer
#End If


Private Sub cmdClose_Click()
    End
End Sub


Private Sub Form_Load()
    Dim myUser As String, myPass As String
    Dim winDir As String * 128
    Dim dirLen As Integer, sysDBLen As Integer
    Dim sysDB As String * 128

    On Error GoTo LoadError

    ' Get the Windows directory and set the INI path.
    dirLen = GetWindowsDirectory(winDir, 128)
    If dirLen = 0 Then Error 32767
    DBEngine.IniPath = Left$(winDir, dirLen) & "\VBDBHT.INI"

    ' Set the user and passwords for initial login.
    myUser = "Admin"
    myPass = "theboss"
    DBEngine.DefaultUser = myUser
    DBEngine.DefaultPassword = myPass

    sysDBLen = GetPrivateProfileString("Options", "SystemDB", "", sysDB, 128, _
        DBEngine.IniPath)
    MsgBox "User Admin connected successfully! System Database is " & sysDB, _
        vbInformation

Exit Sub
LoadError:
    Dim msg As String
    If Err.Number = 32767 Then
        msg = "Cannot find Windows directory."
    Else
        msg = Err.Description
    End If
    MsgBox msg, vbCritical
End
End Sub

Private Sub cmdConnect_Click()
    Dim db As DATABASE
    Dim dbName As String
    Dim rs As Recordset
    Dim ws As Workspace
    Dim myUser As String, myPass As String

    On Error GoTo ConnectError

    ' Verify that we have a user name entered.
    If txtUserName <> "" Then
        myUser = txtUserName
    Else
        Error 32767
    End If

    myPass = txtPassword

    ' Create a new workspace for this user.
    Set ws = DBEngine.CreateWorkspace("MyWS", myUser, myPass)

   ' Get the database name and open the database in the workspace just created.
    dbName = DataPath() & "\CHAPTER.09\ORDERS.MDB"       ' DataPath is a function in READINI.BAS
    Set db = ws.OpenDatabase(dbName)

    ' Open a recordset to verify that we have access.
    Set rs = db.OpenRecordset("SELECT * FROM Customers")

    ' No error occurred, so we must have connected OK.
    MsgBox "User " & txtUserName & " connected successfully!", vbInformation

Exit Sub
ConnectError:
    Dim msg As String
    If Err.Number = 32767 Then
        msg = "You must enter a user name"
    Else
        msg = Err.Description
    End If
    MsgBox msg, vbExclamation
Exit Sub

End Sub